ETO Development Tools 2/ETO Development Tools 2.iso/Tools - Objects/MacApp/MacApp CD Release/MacApp 2.0.1 (Many Libraries)/Libraries/UTEView.TTECommand.p

Text File | 1990-10-25 | 30.9 KB | 1,107 lines | [TEXT/MPS ]

{$P}
{[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
{UTEView.TTECommand.p}
{Copyright © 1984-1990 Apple Computer Inc. All rights reserved.}

{--------------------------------------------------------------------------------------------------}
{$S TESelCommand}

PROCEDURE TTECommand.ITECommand(itsTEView: TTEView;
                                itsCmdNumber: CmdNumber;
                                itsSaveText: BOOLEAN);

    VAR
        selChars:            INTEGER;
        h:                    Handle;
        fi:                 FailInfo;

    PROCEDURE HdlInitFailed(error: OSErr;
                            message: LONGINT);

        BEGIN
        Free;
        END;

    BEGIN
    fTEView := itsTEView;
    fHTE := itsTEView.fHTE;

    WITH fHTE^^ DO
        BEGIN
        fOldStart := selStart;
        fOldEnd := selEnd;
        selChars := selEnd - selStart;
        END;

    fOldText := NIL;
    fOldStyles := NIL;

    fNewStart := 0;
    fNewEnd := 0;
    fNewText := NIL;
    fNewStyles := NIL;

    fPadding := NIL;
    fTextPad := 0;
    fStylePad := 0;

    ICommand(itsCmdNumber, itsTEView.fDocument, itsTEView, NIL);
    CatchFailures(fi, HdlInitFailed);

    IF itsSaveText THEN
        BEGIN
        h := NewPermHandle(selChars);
        FailNIL(h);

        IF selChars > 0 THEN
            BlockMove(Pointer(ORD(fHTE^^.hText^) + fOldStart), h^, selChars);

        fOldText := h;
        fTextPad := fOldStart - fOldEnd;
        fPadding := NewPermHandle(0);
        FailNIL(fPadding);
        END;

 { TextEdit has this "feature" which it exercises if it runs out of memory.  It's
   called DS number 25.  We'll try to avoid it by assuring that enough memory exists
   to fulfill the request, but we won't die because of it.  This is a particularly
   ugly situation - there could be >600K of style information associated with a 32K
   block of text.  And to support undo, we've got to assume that there may momentarily
   be THREE copies floating around, adding up to a total potential liability of almost
   2 Meg for a single TE record.  The worst that can happen, though, is that the text
   will be safe, but it won't have any styles associated with it. }

    IF (itsTEView.fStyleType = kWithStyle) & itsTEView.SpaceForStyles(fHTE^^.selStart,
                                                                      fHTE^^.selEnd) THEN
        BEGIN
        fOldStyles := GetStylScrap(fHTE);
        FailNIL(fOldStyles);
        fStylePad := GetHandleSize(Handle(fOldStyles));
        END;

    Success(fi);

    END;

{--------------------------------------------------------------------------------------------------}
{$S TEDoCommand}

PROCEDURE TTECommand.Free; OVERRIDE;

    BEGIN
    fOldText := DisposeIfHandle(fOldText);
    Handle(fOldStyles) := DisposeIfHandle(fOldStyles);
    fNewText := DisposeIfHandle(fNewText);
    Handle(fNewStyles) := DisposeIfHandle(fNewStyles);
    fPadding := DisposeIfHandle(fPadding);

    INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEDoCommand}

PROCEDURE TTECommand.BanishOldText;

    BEGIN
    IF fOldEnd > fOldStart THEN
        TEDelete(fHTE);
    SetHandleSize(fPadding, MAX( - (fTextPad + fStylePad), 0));
    FailMemError;
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEDoCommand}

PROCEDURE TTECommand.InstallNewText;

    VAR
        savedSize:            LONGINT;
        itsText:            Handle;

    BEGIN
    IF fNewEnd > fNewStart THEN
        BEGIN
        itsText := fTEView.fText;
        savedSize := GetHandleSize(itsText);

        {$IFC qDebug}
        IF fNewText = NIL THEN
            ProgramBreak('InstallNewText called with fNewText = NIL!');
        {$ENDC}

        LockHandleHigh(fNewText);                                { Prevent heap fragmentation for TEInsert }

        IF fTEView.fStyleType = kWithStyle THEN         { If record has style, use it }
            TEStylInsert(fNewText^,                     { It's okay for fNewStyles to be NIL here }
                         GetHandleSize(fNewText), fNewStyles, fHTE)
        ELSE                                            { Otherwise, do it the old-fashioned way }
            TEInsert(fNewText^, GetHandleSize(fNewText), fHTE);

        HUnlock(fNewText);

        IF GetHandleSize(itsText) <= savedSize THEN
            FailOSErr(memFullErr);

        fTEView.fSpecsChanged := TRUE;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEFields}

PROCEDURE TTECommand.Fields(PROCEDURE DoToField(fieldName: Str255;
                                                fieldAddr: Ptr;
                                                fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TTECommand', NIL, bClass);
    DoToField('fTEView', @fTEView, bObject);
    DoToField('fHTE', @fHTE, bTEHandle);
    DoToField('fOldStart', @fOldStart, bInteger);
    DoToField('fOldEnd', @fOldEnd, bInteger);
    DoToField('fOldText', @fOldText, bHandle);
    DoToField('fOldStyles', @fOldStyles, bHandle);
    DoToField('fNewStart', @fNewStart, bInteger);
    DoToField('fNewEnd', @fNewEnd, bInteger);
    DoToField('fNewText', @fNewText, bHandle);
    DoToField('fNewStyles', @fNewStyles, bHandle);
    DoToField('fPadding', @fPadding, bHandle);
    DoToField('fTextPad', @fTextPad, bInteger);
    DoToField('fStylePad', @fStylePad, bLongInt);
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEDoCommand}

PROCEDURE TTECommand.RemoveAdditions;

    BEGIN
    IF fNewText <> NIL THEN
        BEGIN
        TESetSelect(fNewStart, fNewEnd, fHTE);
        TEDelete(fHTE);
        END;
    SetHandleSize(fPadding, MAX(fTextPad + fStylePad, 0));
    FailMemError;
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEDoCommand}

PROCEDURE TTECommand.RestoreSelection;

    BEGIN
    TESetSelect(fOldStart, fOldEnd, fHTE);
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEDoCommand}

PROCEDURE TTECommand.ReviveDeletions;

    VAR
        itsText:            Handle;
        savedSize:            LONGINT;
        nChars:             INTEGER;

    BEGIN
    TESetSelect(fOldStart, fOldStart, fHTE);            { so insert will take place at right point }
    nChars := GetHandleSize(fOldText);
    IF nChars > 0 THEN
        BEGIN
        itsText := fTEView.fText;
        savedSize := GetHandleSize(itsText);

        LockHandleHigh(fOldText);                                { Prevent heap fragmentation }

        IF fTEView.fStyleType = kWithStyle THEN         { If record has style, use it }
            TEStylInsert(fOldText^, nChars,             { It's okay for fOldStyles to be NIL here }
                         fOldStyles, fHTE)
        ELSE                                            { Otherwise, do it the old-fashioned way }
            TEInsert(fOldText^, nChars, fHTE);

        HUnlock(fOldText);

        IF GetHandleSize(itsText) <= savedSize THEN
            FailOSErr(memFullErr);

        fTEView.fSpecsChanged := TRUE;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEDoCommand}

PROCEDURE TTECommand.DoMainFunction;

    BEGIN
    IF fCmdNumber <> cCopy THEN
        BanishOldText;
    InstallNewText;
    IF fCmdNumber <> cCopy THEN
        fTEView.SynchView(kRedraw);
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEDoCommand}

PROCEDURE TTECommand.DoIt; OVERRIDE;

    BEGIN
    IF fTEView.Focus THEN;                                {??? What if Focus fails}

    DoMainFunction;
    {$IFC qDebug}
    IF pTEIntenseDebugging THEN
        DumpTTECommand(SELF);
    {$ENDC}
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEDoCommand}

PROCEDURE TTECommand.UndoIt; OVERRIDE;

    BEGIN
    IF fTEView.Focus THEN;                                {??? What if Focus fails}

    RemoveAdditions;
    ReviveDeletions;
    RestoreSelection;
    IF fCmdNumber <> cCopy THEN
        fTEView.SynchView(kRedraw);
    {$IFC qDebug}
    IF pTEIntenseDebugging THEN
        DumpTTECommand(SELF);
    {$ENDC}
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEDoCommand}

PROCEDURE TTECommand.RedoIt; OVERRIDE;

    BEGIN
    IF fTEView.Focus THEN;                                {??? What if Focus fails}

    RestoreSelection;
    DoMainFunction;
    {$IFC qDebug}
    IF pTEIntenseDebugging THEN
        DumpTTECommand(SELF);
    {$ENDC}
    END;

{--------------------------------------------------------------------------------------------------}
{$S TESelCommand}

PROCEDURE TTECutCopyCommand.ITECutCopyCommand(itsTEView: TTEView;
                                              itsCmdNumber: CmdNumber);

    BEGIN
    fClipCreated := FALSE;
    ITECommand(itsTEView, itsCmdNumber, TRUE);
    fChangesClipboard := TRUE;
    fCausesChange := itsCmdNumber <> cCopy;
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEDoCommand}

PROCEDURE TTECutCopyCommand.Free; OVERRIDE;

    BEGIN
    IF fClipCreated THEN
        fOldText := NIL;
    INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEDoCommand}

PROCEDURE TTECutCopyCommand.DoIt; OVERRIDE;

    VAR
        clipTEView:         TTEView;
        clipHere:            BOOLEAN;
        fi:                 FailInfo;
        clipStyle:            TextStyle;
        itsSize:            VPoint;
        itsMargins:         Rect;

    PROCEDURE HdlClipFailed(error: OSErr;
                            message: LONGINT);

        BEGIN
        FreeIfObject(clipTEView);
        clipTEView := NIL;
        END;

    BEGIN                                                {TTECutCopyCommand.DoIt}
    IF fTEView.Focus THEN;                                {??? What if Focus fails}

    SetTextStyle(clipStyle, applFont, [],                { Initial style same as virgin TEView }
                 12, gRGBBlack);

    SetVPt(itsSize, 100, 50);                            { An arbitrary initial size. }
    SetRect(itsMargins, 10, 8, 10, 0);                    { No bottom margin. }

    New(clipTEView);                                    { Create a new view for the clipboard }
    FailNIL(clipTEView);
    WITH fTEView DO
        clipTEView.ITEView(NIL, NIL,                    { Initialize view }
                           gZeroVPt, itsSize, sizeSuperView, sizeVariable, itsMargins, clipStyle,
                           teJustSystem, fStyleType, fAutoWrap);
    clipTEView.fAcceptsChanges := FALSE;                { This is a read-only view }

    CatchFailures(fi, HdlClipFailed);                    { Cut can eat into temp memory so users can
                                                         }
    { …rescue text from overweight documents }
    IF NOT fCausesChange THEN                            { If Copy-ing, assure there's enough room }
        FailSpaceIsLow;
    Success(fi);
    clipTEView.StuffText(fOldText);
    FailSpaceIsLow;

    {??? GOT TO FIGURE OUT SOME WAY TO PRE-FLIGHT THIS! ??????????????????????????????????? }
    IF clipTEView.fStyleType = kWithStyle THEN            { If record has style }
        SetStylScrap(0, MAXINT, fOldStyles,             { …then put in the styles }
                     kDontRedraw, clipTEView.fHTE);
    FailSpaceIsLow;

    clipTEView.fFreeText := TRUE;                        { Let TEView know it has to free the text }

    gApplication.ClaimClipboard(clipTEView);            { Okay to claim (will call RecalcText!) }

    fClipCreated := TRUE;                                { We be done }
    DoMainFunction;                                     { Do the actual cut/copy }

    {$IFC qDebug}
    IF pTEIntenseDebugging THEN
        BEGIN
        DumpTERecord(clipTEView.fHTE);
        DumpTTECommand(SELF);
        END;
    {$ENDC}
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEDoCommand}

PROCEDURE TTECutCopyCommand.ReviveDeletions; OVERRIDE;

    BEGIN
    IF fCmdNumber = cCut THEN
        INHERITED ReviveDeletions;                        { Don't do it for COPY }
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEFields}

PROCEDURE TTECutCopyCommand.Fields(PROCEDURE DoToField(fieldName: Str255;
                                                       fieldAddr: Ptr;
                                                       fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TTECutCopyCommand', NIL, bClass);
    DoToField('fClipCreated', @fClipCreated, bBoolean);
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S TESelCommand}

PROCEDURE TTEPasteCommand.ITEPasteCommand(itsTEView: TTEView);
{ We can't use TEPaste because it clobbers the DeskScrap; the text would be recoverable
  from the special TextEdit Scrap, but other types of non-TEXT scrap are permanently
  lost, it seems }

    VAR
        savedPerm:            BOOLEAN;
        newLength:            INTEGER;
        newStyleLen:        LONGINT;
        newText:            Handle;
        newStyles:            StScrpHandle;
        dataType:            ResType;
        fi:                 FailInfo;

    PROCEDURE HdlPasteFailed(error: OSErr;
                             message: LONGINT);

        BEGIN
        IF newText <> fNewText THEN                     { newText is assigned to fNewText }
            newText := DisposeIfHandle(newText);        { …so avoid disposing twice. }
        IF newStyles <> fNewStyles THEN                 { Ditto for newStyles. }
            Handle(newStyles) := DisposeIfHandle(newStyles);
        Free;
        END;

    BEGIN
    ITECommand(itsTEView, cPaste, TRUE);                { Perform stock initializations }

    savedPerm := FALSE;

    newStyleLen := 0;                                    { Assume there are no new styles }
    newStyles := NIL;
    newText := NIL;

    CatchFailures(fi, HdlPasteFailed);

    newText := NewPermHandle(0);                        { Create handle to receive clipboard data }
    FailNIL(newText);
    IF itsTEView.fStyleType = kWithStyle THEN
        BEGIN
        newStyles := StScrpHandle(NewPermHandle(0));    { Same for handle to receive style info }
        FailNIL(newStyles);
        END;

    newLength := gApplication.GetDataToPaste(newText, dataType);

    IF newLength > 0 THEN
        BEGIN
        {$IFC qDebug}
        IF dataType <> 'TEXT' THEN
            ProgramBreak('TEPasteCommand given some non-text from clipboard')
        ELSE
        {$ENDC}
            BEGIN                                        { Prime "new" values }
            fNewText := newText;
            fNewStart := fHTE^^.selStart;
            fNewEnd := fNewStart + newLength;
            fTextPad := newLength - (fOldEnd - fOldStart);

            IF itsTEView.fStyleType = kWithStyle THEN
                BEGIN
                newStyleLen := gClipView.GivePasteData(Handle(newStyles), 'styl');
                IF newStyleLen > 0 THEN
                    BEGIN
                    fNewStyles := newStyles;
                    { Difference between old and new styles }
                    fStylePad := newStyleLen - fStylePad;
                    END
                ELSE
                    newStyles := StScrpHandle(DisposeIfHandle(newStyles));
                END;

            SetPermHandleSize(fPadding, MAX(fTextPad + fStylePad, 0));

            FailSpaceIsLow;
            END;
        END
    ELSE
        BEGIN
        newText := DisposeIfHandle(newText);
        Handle(newStyles) := DisposeIfHandle(newStyles);
        END;
    Success(fi);
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEFields}

PROCEDURE TTEPasteCommand.Fields(PROCEDURE DoToField(fieldName: Str255;
                                                     fieldAddr: Ptr;
                                                     fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TTEPasteCommand', NIL, bClass);
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S TESelCommand}

PROCEDURE TTEStyleCommand.ITEStyleCommand(itsTEView: TTEView;
                                          itsNewStyle: TextStyle;
                                          itsCmdNumber: CmdNumber;
                                          itsMode: INTEGER);

    VAR
        savedPerm:            BOOLEAN;
        fi:                 FailInfo;

    BEGIN

    ITECommand(itsTEView, itsCmdNumber, FALSE);         { Perform stock initialization, sans text }

    fOldTextStyle := itsTEView.fTextStyle;
    fNewTextStyle := itsNewStyle;

    { Only do color change if we can }
    IF qNeedsColorQD | gConfiguration.hasColorQD THEN
        fMode := itsMode
    ELSE
        fMode := BAND(itsMode, BNOT(doColor));
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEDoCommand}

PROCEDURE TTEStyleCommand.InstallOneStyle(newStyl: TextStyle);

    BEGIN
    fTEView.SetOneStyle(fOldStart, fOldEnd, fMode, newStyl, kRedraw); { Focus'es for us }
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEDoCommand}

PROCEDURE TTEStyleCommand.InstallManyStyles(newStyls: StScrpHandle);

    BEGIN
    IF fTEView.Focus THEN;
    { No need to check for fStyleType, since we only get here if the record is stylish }
    SetStylScrap(fOldStart, fOldEnd, newStyls, kRedraw, fHTE);
    fTEView.RecalcText;                                 { Might have changed number of lines }
    fTEView.SynchView(kRedraw);                         { Show corrected view }

    fTEView.fSpecsChanged := TRUE;
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEDoCommand}

PROCEDURE TTEStyleCommand.DoIt; OVERRIDE;

    VAR
        aTextStyle:         TextStyle;

    BEGIN
    aTextStyle := fNewTextStyle;
    InstallOneStyle(aTextStyle);
    fMode := BAND(fMode, BNOT(doToggle));                { Turn off toggle mode, if set }
    {$IFC qDebug}
    IF pTEIntenseDebugging THEN
        DumpTTECommand(SELF);
    {$ENDC}
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEDoCommand}

PROCEDURE TTEStyleCommand.UndoIt; OVERRIDE;

    VAR
        aTextStyle:         TextStyle;

    BEGIN
    RestoreSelection;

    IF fTEView.fStyleType = kWithoutStyle THEN
        BEGIN
        aTextStyle := fOldTextStyle;
        InstallOneStyle(aTextStyle);
        END
    ELSE
        InstallManyStyles(fOldStyles);
    {$IFC qDebug}
    IF pTEIntenseDebugging THEN
        DumpTTECommand(SELF);
    {$ENDC}
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEDoCommand}

PROCEDURE TTEStyleCommand.RedoIt; OVERRIDE;

    BEGIN
    RestoreSelection;
    DoIt;
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEFields}

PROCEDURE TTEStyleCommand.Fields(PROCEDURE DoToField(fieldName: Str255;
                                                     fieldAddr: Ptr;
                                                     fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TTEStyleCommand', NIL, bClass);
    DoToField('fMode', @fMode, bInteger);
    {$Push} {$H-}
    TextStyleFields('fOldTextStyle', fOldTextStyle, DoToField);
    TextStyleFields('fNewTextStyle', fNewTextStyle, DoToField);
    {$Pop}
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S TERes}

PROCEDURE TTETypingCommand.ITETypingCommand(itsTEView: TTEView;
                                            itsFirstChar: Char);

    VAR
        fi:                 FailInfo;

    PROCEDURE HdlInitFailed(error: OSErr;
                            message: LONGINT);

        BEGIN
        Free;
        END;

    BEGIN
    ITECommand(itsTEView, cTyping, TRUE);

    CatchFailures(fi, HdlInitFailed);

    fNewStart := fHTE^^.selStart;                        { Start and end are the same }
    fNewEnd := fNewStart;

    fNewText := NewPermHandle(0);                        { Allocate an empty block for text }
    FailNIL(fNewText);

    fCompleted := FALSE;                                { We've only just begun… }
    fFirstChar := itsFirstChar;                         { Save character for Doit }
    Success(fi);
    END;

{--------------------------------------------------------------------------------------------------}
{$S TERes}

PROCEDURE TTETypingCommand.Free; OVERRIDE;

    BEGIN
    IF fTEView.fTypingCommand = SELF THEN
        fTEView.fTypingCommand := NIL;
    INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S TERes}

PROCEDURE TTETypingCommand.DoNormalChar(aChar: Char);

    BEGIN
    FailOSErr(PtrAndHand(Ptr(SUCC(ORD(@aChar))),        { Append char to end of fNewText }
                         fNewText, 1));
    fNewEnd := SUCC(fNewEnd);                            { Bump both end of "selection" }
    fTextPad := SUCC(fTextPad);                         { …and padding value }

    SetHandleSize(fPadding,                             { This SetHandleSize can't grow the handle,
                                                         }
                  MAX( - (fTextPad + fStylePad), 0));    { …so it shouldn't fail. }
    FailMemError;
    END;

{--------------------------------------------------------------------------------------------------}
{ User has backspaced to the left of the original starting point.  First, copy the
 character (which may be more than one byte long if we are using a non-Roman script)
 to a temporary buffer.  The assumption is that no character will ever be longer
 than four bytes.  Sorry, folks, MacApp does not support typing in any script with
 more than 4 billion characters.
  Next, copy the character to the front of fOldText, and adjust fOldStart, fNewStart,
 and fNewEnd.  Note that we do NOT check for MemSpaceIsLow, since we want to let the
 user delete characters. }
{$S TERes}

PROCEDURE TTETypingCommand.BkSpcLeft(theText: Handle;
                                     curStart: INTEGER);

    TYPE
        TSPtr                = ^TextStyle;

    VAR
        savedSize:            INTEGER;
        theHeight:            INTEGER;
        theAscent:            INTEGER;
        oldSize:            LONGINT;
        whoCares:            LONGINT;
        aTextStyle:         TSPtr;
        savedChar:            PACKED ARRAY [0..3] OF Char;
        delStyle:            TextStyle;
        {$IFC qDebug}
        savedPerm:            BOOLEAN;
        {$ENDC}

    BEGIN
    savedSize := 1;
    IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
        WHILE CharByte(theText^, curStart - savedSize) > 0 DO
            savedSize := SUCC(savedSize);
    curStart := curStart - savedSize;

    {$IFC qDebug}
    IF savedSize > 4 THEN
        ProgramBreak('Character > 4 bytes');
    {$ENDC}
    IF savedSize = 1 THEN                                { Slight speed optimization for normal case
                                                         }
    {$Push} {$R-}
        savedChar[0] := CharsHandle(theText)^^[curStart]
        {$Pop}
    ELSE
        BlockMove(Ptr(ORD(theText^) + curStart), @savedChar, savedSize);

    IF fTEView.fStyleType = kWithStyle THEN             { Only do this if styles are around }
        BEGIN
        TEGetStyle(curStart, delStyle,                    { Get the style of the deleted character }
                   theHeight, theAscent, fHTE);         { (1 or 4 bytes, it's all only one style) }

        IF NOT EqualBlocks(@delStyle,                    { If style doesn't match first in the list }
                           @fOldStyles^^.scrpStyleTab[0].scrpFont, SIZEOF(TextStyle)) THEN
            BEGIN                                        { …then insert new style at head of list }
            fTEView.fSpecsChanged := TRUE;                { User backspaced into new style! }

            oldSize :=                                    { Make room for the new style element }
              GetHandleSize(Handle(fOldStyles));
            SetHandleSize(Handle(fOldStyles), oldSize + SIZEOF(ScrpSTElement));
            FailMemError;
            fStylePad := fStylePad + SIZEOF(ScrpSTElement);

            {$Push} {$H-}
            WITH fOldStyles^^.scrpStyleTab[0] DO
                BlockMove(@scrpStartChar,                { Move entire array up one element's size }
                          Ptr(ORD(@scrpStartChar) + SIZEOF(ScrpSTElement)), oldSize -
                          SIZEOF(fOldStyles^^.scrpNStyles));
            {$Pop}

            fOldStyles^^.scrpNStyles :=                 { One more style }
              SUCC(fOldStyles^^.scrpNStyles);
            WITH fOldStyles^^.scrpStyleTab[0] DO
                BEGIN
                scrpHeight := theHeight;                { Fill in the blanks }
                scrpAscent := theAscent;
                aTextStyle := TSPtr(@scrpFont);
                aTextStyle^ := delStyle;
                END;
            END;

        WITH fOldStyles^^.scrpStyleTab[0] DO
            scrpStartChar := PRED(scrpStartChar);        { Regardless, back off offset by one }
        END;

    SetHandleSize(fPadding, GetHandleSize(fOldText) + savedSize + fStylePad);
    FailMemError;
    whoCares := Munger(fOldText, 0, NIL, 0, @savedChar, savedSize);
    FailMemError;
    fOldStart := curStart;                                { Treat this as though original selection }
    fNewStart := curStart;                                { …had included this character }
    fNewEnd := curStart;
    fTextPad := fTextPad - savedSize;
    END;

{--------------------------------------------------------------------------------------------------}
{$S TERes}

PROCEDURE TTETypingCommand.BkSpcRight(theText: Handle;
                                      curStart: INTEGER);

    VAR
        savedSize:            INTEGER;

    BEGIN
    savedSize := 1;
    IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
        WHILE CharByte(theText^, curStart - savedSize) > 0 DO
            savedSize := SUCC(savedSize);
    SetHandleSize(fPadding, MAX( - (fTextPad - savedSize + fStylePad), 0));
    FailMemError;
    fNewEnd := fNewEnd - savedSize;
    fTextPad := fTextPad - savedSize;

    SetHandleSize(fNewText, fNewEnd - fNewStart);        { Shouldn't fail as we're only shrinking it
                                                         }
    FailMemError;
    END;

{--------------------------------------------------------------------------------------------------}
{ Forward delete courtesy of: Larry Goldman.  Used by permission. }
{$S TERes}

PROCEDURE TTETypingCommand.FwdDelete(theText: Handle;
                                     curStart, curEnd: INTEGER);

    TYPE
        TSPtr                = ^TextStyle;

    VAR
        savedSize:            INTEGER;
        theHeight:            INTEGER;
        theAscent:            INTEGER;
        oldSize:            LONGINT;
        whoCares:            LONGINT;
        aTextStyle:         TSPtr;
        savedChar:            PACKED ARRAY [0..3] OF Char;
        delStyle:            TextStyle;
        textSize:            LONGINT;
        oldTextSize:        LONGINT;

    BEGIN
    textSize := GetHandleSize(theText);
    IF (curStart = curEnd) & (curStart < textSize) THEN
        BEGIN

        savedSize := 0;                                 {Get the complete character}
        IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
            WHILE (curStart + savedSize <= textSize) & (CharByte(theText^, curStart + savedSize) >
                  0) DO
                savedSize := SUCC(savedSize);
        savedSize := savedSize + 1;
        {$IFC qDebug}
        IF savedSize > 4 THEN
            ProgramBreak('Character > 4 bytes');
        {$ENDC}

        IF savedSize = 1 THEN                            { Slight speed optimization for normal case
                                                         }
        {$Push} {$R-}
            savedChar[0] := CharsHandle(theText)^^[curStart]
            {$Pop}
        ELSE
            BlockMove(Ptr(ORD(theText^) + curStart), @savedChar, savedSize);

        IF (curStart >= fNewStart) & (curStart < fNewEnd) THEN { char is within fNewText }
            BEGIN                                        {Remove the char from fNewText and update
                                                         fNewEnd and fTextPad}
            SetHandleSize(fPadding, MAX( - (fTextPad - savedSize + fStylePad), 0));
            FailMemError;
            fNewEnd := fNewEnd - savedSize;
            fTextPad := fTextPad - savedSize;

            { Shouldn't fail as we're only shrinking it }
            whoCares := Munger(fNewText, curStart - fNewStart, NIL, savedSize, @savedChar, 0);
            FailMemError;
            END
        ELSE                                            { add char to the end of fOldChars, don't
                                                         update fOldEnd, but update fPadding}
            BEGIN
            oldTextSize := GetHandleSize(fOldText);
            IF fTEView.fStyleType = kWithStyle THEN     { Only do this if styles are around }
                BEGIN
                TEGetStyle(curStart, delStyle,            { Get the style of the deleted character }
                           theHeight, theAscent, fHTE); { (1 or 4 bytes, it's all only one style) }

                IF NOT EqualBlocks(@delStyle,            { If style doesn't match last in the list }
                                   @fOldStyles^^.scrpStyleTab[fOldStyles^^.scrpNStyles -
                                   1].scrpFont, SIZEOF(TextStyle)) THEN
                    BEGIN                                { …then insert new style at end of list }
                    fTEView.fSpecsChanged := TRUE;        { User backspaced into new style! }

                    oldSize :=                            { Make room for the new style element }
                      GetHandleSize(Handle(fOldStyles));
                    SetHandleSize(Handle(fOldStyles), oldSize + SIZEOF(ScrpSTElement));
                    FailMemError;
                    fStylePad := fStylePad + SIZEOF(ScrpSTElement);

                    fOldStyles^^.scrpNStyles :=         { One more style }
                      SUCC(fOldStyles^^.scrpNStyles);
                    WITH fOldStyles^^.scrpStyleTab[fOldStyles^^.scrpNStyles - 1] DO
                        BEGIN
                        scrpStartChar := oldTextSize;
                        scrpHeight := theHeight;        { Fill in the blanks }
                        scrpAscent := theAscent;
                        aTextStyle := TSPtr(@scrpFont);
                        aTextStyle^ := delStyle;
                        END;
                    END;
                END;

            SetHandleSize(fPadding, oldTextSize + savedSize + fStylePad);
            FailMemError;
            whoCares := Munger(fOldText, oldTextSize, NIL, 0, @savedChar, savedSize);
            FailMemError;
            fTextPad := fTextPad - savedSize;

            END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{ ??? All this handle munging is expensive.  Better would be to accumulate memory in
  "chunks" of, say, 16 bytes so that this checking need not happen every time through.
  Fortunately, the normal cases are not that bad. }
{$S TERes}

PROCEDURE TTETypingCommand.AddCharacter(aChar: Char);

    VAR
        theText:            Handle;
        curSelStart:        INTEGER;
        curSelEnd:            INTEGER;
        savedPerm:            BOOLEAN;
        fi:                 FailInfo;
        index:                INTEGER;

    PROCEDURE HdlCharFailed(error: OSErr;
                            message: LONGINT);

        BEGIN
        savedPerm := PermAllocation(savedPerm);
        END;

    BEGIN
    fView.Update;                                        { Makes sure that all of TE's actions are
                                                         Visible }
    IF fView.Focus THEN;
    WITH fHTE^^ DO                                        { Get handy info about the text handle }
        BEGIN
        curSelStart := selStart;
        curSelEnd := selEnd;
        theText := hText;
        END;
    CatchFailures(fi, HdlCharFailed);
    savedPerm := PermAllocation(TRUE);

 { Update the fNewText handle and other information.  Note that because of backspace,
  this can be tricky.}

    IF (aChar = chFwdDelete) THEN
        FwdDelete(theText, curSelStart, curSelEnd)        { User types forward delete, so keep in
                                                         synch}

    ELSE IF aChar <> chBackspace THEN                    { Not a backspace. Do the right thing }
        DoNormalChar(aChar)

    ELSE IF (curSelStart <= fOldStart) &                { User typed backspace so keep in synch }
            (curSelStart > 0) & (curSelStart = curSelEnd) THEN
        BkSpcLeft(theText, curSelStart)                 { Handle backspace to left of start }

    ELSE IF fNewEnd > fNewStart THEN                    { Delete 1 character from end of fNewText }
        BkSpcRight(theText, curSelStart);                { Handle backspace to right of start }

    savedPerm := PermAllocation(savedPerm);
    Success(fi);

    IF aChar <> chFwdDelete THEN
 { Let TextEdit have the character, as either 1) we're adding a byte, so we know there
  is a reserve tank, so the worst this will do is eat into it a little, or 2) we're
  deleting a character, which can only decrease memory usage. }
        TEKey(aChar, fHTE)
    ELSE IF (curSelStart <> curSelEnd) THEN             { forward delete with chars selected}
        TEDelete(fHTE)
    ELSE IF (curSelStart < GetHandleSize(theText)) THEN
        BEGIN                                            { forward delete with insertion point}
        TEKey(chRight, fHTE);
        TEKey(chBackspace, fHTE);
        END;

    fTEView.SynchView(kRedraw);                         { Now clean up the view. }

    {$IFC qDebug}
    IF pTEIntenseDebugging THEN
        BEGIN
        WrLblHandleContents('fOldText', fOldText);
        WRITELN;
        WrLblHandleContents('fNewText', fNewText);
        WRITELN;
        DumpTTECommand(SELF);
        END;
    {$ENDC}

    END;

{--------------------------------------------------------------------------------------------------}
{$S TERes}

PROCEDURE TTETypingCommand.DoIt; OVERRIDE;

    BEGIN
    AddCharacter(fFirstChar);
    {$IFC qDebug}
    IF pTEIntenseDebugging THEN
        DumpTTECommand(SELF);
    {$ENDC}
    END;

{--------------------------------------------------------------------------------------------------}

{$S TEDoCommand}

PROCEDURE TTETypingCommand.RedoIt; OVERRIDE;

    VAR
        currentStyle:        TextStyle;
        lineHeight:         INTEGER;
        fontAscent:         INTEGER;
        resetStyle:         BOOLEAN;

    BEGIN
    IF (fOldEnd - fOldStart) = GetHandleSize(fOldText) THEN
        BEGIN                                            { No chars were vacuumed}
        resetStyle := FALSE;
        IF (fTEView.fStyleType = kWithStyle) & (fOldEnd = fOldStart) THEN
            BEGIN
            TEGetStyle(fOldStart, currentStyle, lineHeight, fontAscent, fHTE);
            resetStyle := NOT EqualBlocks(@currentStyle, @fOldStyles^^.scrpStyleTab[0].scrpFont,
                                          SIZEOF(TextStyle));
            END;

        IF resetStyle THEN                                { The new text has a style of its own }
            fNewStyles := fOldStyles;                    { Make InstallNewText insert styles, too }
        INHERITED RedoIt;
        IF resetStyle THEN
            fNewStyles := NIL;                            { So fNewStyles doesn't get disposed }
        END
    ELSE
        BEGIN
        IF fTEView.Focus THEN;                            {??? What if Focus fails}
        TESetSelect(fOldStart, fOldStart + GetHandleSize(fOldText), fHTE); { select vacuumed chars,
            too }
        TEDelete(fHTE);                                 { Remove old text, including vacuumed chars}
        SetHandleSize(fPadding, MAX( - (fTextPad + fStylePad), 0));
        FailMemError;
        InstallNewText;
        fTEView.SynchView(kRedraw);
        {$IFC qDebug}
        IF pTEIntenseDebugging THEN
            DumpTTECommand(SELF);
        {$ENDC}
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEDoCommand}

PROCEDURE TTETypingCommand.UndoIt; OVERRIDE;

    BEGIN
    CompleteTyping;
    INHERITED UndoIt;
    END;

{--------------------------------------------------------------------------------------------------}
{$S TERes}

PROCEDURE TTETypingCommand.CompleteTyping;

    VAR
        i:                    INTEGER;
        offset:             LONGINT;

    BEGIN
    fCompleted := TRUE;

    IF fTEView.fStyleType = kWithStyle THEN
        WITH fOldStyles^^ DO
            BEGIN
            offset := - scrpStyleTab[0].scrpStartChar;
            IF offset > 0 THEN
                FOR i := 0 TO scrpNStyles - 1 DO
                    scrpStyleTab[i].scrpStartChar := scrpStyleTab[i].scrpStartChar + offset;
            END;
    {$IFC qDebug}
    IF pTEIntenseDebugging THEN
        DumpTTECommand(SELF);
    {$ENDC}
    END;

{--------------------------------------------------------------------------------------------------}
{$S TEFields}

PROCEDURE TTETypingCommand.Fields(PROCEDURE DoToField(fieldName: Str255;
                                                      fieldAddr: Ptr;
                                                      fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TTETypingCommand', NIL, bClass);
    DoToField('fCompleted', @fCompleted, bBoolean);
    DoToField('fFirstChar', @fFirstChar, bBoolean);
    INHERITED Fields(DoToField);
    END;